home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
MENU_UTL
/
TPPDMENU
/
TPPDMENU.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-01-11
|
32KB
|
960 lines
{$S-,R-,V-,I-,B-,F-}
{$IFDEF Ver40}
{$F-}
{$ELSE}
{$F+}
{$I OPLUS.INC}
{$ENDIF}
{$IFDEF Debug}
{$D+}
{$ENDIF}
{Conditional defines that may affect this unit}
{$I TPDEFINE.INC}
{*********************************************************}
{* TPPDMENU.PAS 5.06 *}
{* Copyright (c) Ken Henderson 1989, 1990. *}
{* *}
{* *}
{* *}
{*********************************************************}
unit TpPdmenu;
{-Pulldown menu systems}
interface
uses
TpCrt, {Turbo Professional CRT unit}
Dos, {DOS interface - standard unit}
{$IFDEF UseMouse}
TpMouse, {Turbo Professional mouse routines}
TpPdMous, {Mouse support for TpPdMenu}
{$ENDIF}
TpWindow, {Turbo Professional popup window management}
TpString; {Turbo Professional string handling routines}
const
MaxMenuDepth = 3; {Maximum depth of menus}
MaxSelections = 20; {Maximum number of selections in one menu}
Null = #0;
OnOff : array[Boolean] of String[3] = ('ON ', 'OFF');
type
ColorType = {Screen colors}
(TextColor, {Normal menu color}
FrameColor, {Menu frame color}
SelectColor, {Selected menu item color}
HighLightColor {Highlighted selection character in menu}
);
{Stores screen attributes}
MenuAttributeArray = array[ColorType] of Byte;
{-Types to define user parameters}
UserHelpType = procedure(OptionIndex : Integer);
UserValidationType = function(OptionIndex : Integer) : Boolean;
UserEvaluateType = procedure(C : Integer; Stat : Byte; var S : String);
{-Array to store menu data in, (size is arbitrary)}
InitArray = array[1..4096] of Byte;
InitArrayPtr = ^InitArray;
{-Definitions for pulldown menu system}
MenuOrientation = (Horizontal, Vertical); {Horizontal or vertical scrolling menus}
MenuDescriptor =
record
Orientation : MenuOrientation; {Horizontal or vertical}
Overlap : WindowPtr; {Points to buffer holding what it covers}
end;
Menulevels = array[1..MaxMenuDepth] of MenuDescriptor;
Menuptr = ^Menurecord;
SubMenuRecord = {12 bytes}
record
Command : Integer; {Command returned via selection}
Doffset : Byte; {Rows or cols offset for prompt within window}
StatVal : Byte; {Indicates whether entry display also has status info}
Soffset : Byte; {Offset into prompt of Select char (for highlight)}
Prompt : ^String; {Points to string displayed for menu item}
SubMenu : Menuptr; {Points to submenu if any}
end;
SubArray = array[1..MaxSelections] of SubMenuRecord;
Menurecord = {12 bytes}
record
MenuLev : Byte; {Depth of this menu, points into MenuDescriptor array}
XPosn : Byte; {X upper left. not border, but text position}
YPosn : Byte; {Y upper left. not border, but text position}
XSize : Byte; {Number of characters of text}
YSize : Byte; {Number of lines of text}
SubMax : Byte; {Number of selections or submenus}
SubCur : Byte; {Currently active submenu or selection}
SubOn : Boolean; {True if submenu is simultaneously displayed}
SubMenus : ^SubArray; {Points to array of selections}
end;
var
MenuDesc : Menulevels; {General specification of each menu level}
RootMenu : Menuptr; {The menu that starts it all}
CurrMenu : Menuptr; {Currently active menu}
ExitMenu : Boolean; {False to loop within menu system}
MenuDataSize, MenuResult : Integer; {Menu data file size and array dimension, Result of initmenus}
P : InitArrayPtr; {Pointer to menu data area}
ScreenAttr : MenuAttributeArray; {-Global to store colors passed to init routine}
UserHelp : UserHelpType; {-User defined help routine when F1 is pressed}
UserValidation : UserValidationType; {-User defined routine to validate
access to a menu item}
UserExitMenus : UserValidationType; {-Allow exit from the menu system}
UserEvaluateSpecial : UserEvaluateType; {-User defined routine to allow
display of variables on menus}
ToggleBoolean : Integer; {-Allows pressing space or backspace to force a
boolean variable to ON or OFF, respectively.
0=no change,
1=force to OFF,
2=force to ON
Check it on return from the menu system and set
your variable accordingly}
procedure GetMenuChoice(var Cmd : Integer; var ExitMenu : Boolean);
{-Display the menu system, and get a selection}
function InitMenus(MenuName : String; ColorTable : MenuAttributeArray;
UserDefinedHelpPtr,
UserDefinedValidationPtr,
UserdefinedEvaluatePtr,
UserDefinedExitMenusPtr,
BuiltInMenuAddress : Pointer) : Integer;
procedure ToggleBooleanVal(var InBoolean : Boolean);
{-A routine to force the state of a boolean variable based on the value of
the global ToggleBoolean variable. This allows you, for instance, to
build keyboard macros that set the state of a boolean variable in the
menu system without first knowing the variable's value.}
{==========================================================================}
implementation
procedure ToggleBooleanVal(var InBoolean : Boolean);
{-A routine to force the state of a boolean variable based on the value of
the global ToggleBoolean variable. This allows you, for instance, to
build keyboard macros that set the state of a boolean variable in the
menu system without first knowing the variable's value.}
begin
case ToggleBoolean of
2 : InBoolean := True; {Force it to ON}
1 : InBoolean := False; {Force it to OFF}
else
InBoolean := not(InBoolean); {Otherwise, just toggle it}
end;
ToggleBoolean := 0;
end;
procedure DrawItem(Menu : Menuptr; sub : Byte);
{-Draw menu item "sub" of the chosen menu}
const
{Flags used for status display in menu system}
NoStat = 0; {Entry displays no status}
BoolStat = 1; {Entry displays boolean - ON/OFF - status}
NumStat = 2; {Entry displays numeric status}
StrStat = 3; {Entry displays string status}
var
R, C, Len : Byte;
S : String;
Orient : MenuOrientation;
begin {DrawItem}
{Get the orientation of the current menu}
Orient := MenuDesc[Menu^.MenuLev].Orientation;
with Menu^, SubMenus^[sub] do
begin
{Copy the prompt to a work string}
Len := Ord(Prompt^[0]);
R := YPosn;
C := XPosn;
{Pad with blanks left and right}
if Orient = Vertical then
begin
S[0] := Chr(XSize);
R := R+Doffset;
end
else
begin
S[0] := Chr(Len+2);
C := C+Doffset;
end;
FillChar(S[1], Length(S), #32);
Move(Prompt^[1], S[2], Len);
if StatVal <> NoStat then
{Special cases to display status items, etc}
if @UserEvaluateSpecial <> nil then
UserEvaluateSpecial(Command, StatVal, S);
if (@UserValidation <> nil) then
begin
if (Menu^.SubCur <> sub) then
begin
if (UserValidation(Command)) then
begin
{Write item with highlighted selection character}
FastWrite(Copy(S, 1, Soffset), R, C, ScreenAttr[TextColor]);
FastWrite(S[Succ(Soffset)], R, C+Soffset, ScreenAttr[HighLightColor]);
FastWrite(Copy(S, Soffset+2, Length(S)), R, Succ(C+Soffset), ScreenAttr[TextColor]);
end
else FastWrite(S, R, C, ScreenAttr[TextColor])
end
else
{Write the selected prompt}
FastWrite(S, R, C, ScreenAttr[SelectColor]);
end
else
begin
if Menu^.SubCur <> sub then
begin
{Write item with highlighted selection character}
FastWrite(Copy(S, 1, Soffset), R, C, ScreenAttr[TextColor]);
FastWrite(S[Succ(Soffset)], R, C+Soffset, ScreenAttr[HighLightColor]);
FastWrite(Copy(S, Soffset+2, Length(S)), R, Succ(C+Soffset), ScreenAttr[TextColor]);
end
else
{Write the selected prompt}
FastWrite(S, R, C, ScreenAttr[SelectColor]);
end;
end;
end; {DrawItem}
procedure UndrawMenu(Menu : Menuptr);
{-remove the menu and its children from the screen}
begin {Undrawmenu}
if Menu = nil then
Exit;
with Menu^ do
begin
{Undraw any submenus - must do first to get proper screen restore}
if SubOn then
begin
UndrawMenu(SubMenus^[SubCur].SubMenu);
SubOn := False;
end;
with MenuDesc[MenuLev] do
{Restore whatever the menu overlapped on the screen}
DisposeWindow(EraseTopWindow);
end;
end; {Undrawmenu}
procedure EraseMenus;
{-Remove the menu system from the screen}
begin {EraseMenus}
UndrawMenu(RootMenu);
CurrMenu := nil;
NormalCursor;
end; {EraseMenus}
procedure DrawMenu(Menu : Menuptr);
{-Draw a menu and its selected children on the screen}
var
I : Byte;
S : String;
begin {DrawMenu}
if Menu = nil then
Exit;
with Menu^ do
begin
with MenuDesc[MenuLev] do
begin
{Create a window to contain the menu}
if MakeWindow(Overlap, Pred(XPosn), Pred(YPosn), XPosn+XSize, YPosn+YSize, True, True, True,
ScreenAttr[TextColor], ScreenAttr[FrameColor], ScreenAttr[FrameColor], '') then
if DisplayWindow(Overlap) then ; {You may wish to put some error trapping here}
end;
{Draw each item in the menu}
for I := 1 to SubMax do
DrawItem(Menu, I);
{Draw any submenus}
if SubOn then
DrawMenu(SubMenus^[SubCur].SubMenu);
end;
end; {Drawmenu}
procedure GetMenuChoice(var Cmd : Integer; var ExitMenu : Boolean);
{-Display the menu system, and get a selection}
type
{Available commands when menu selection is being made}
MenuCommandType = (Mup, Mdown, Mright, Mleft, Mesc, Msel, Mhelp, Mnul);
var
Ch : Char;
Mcmd : MenuCommandType;
Done : Boolean;
sub : Byte;
function MenuCommand(CurrMenu : Menuptr;
var Ch : Char;
var Mcmd : MenuCommandType) : Boolean;
{-Return a menucommand or a character}
type
str1 = String[1];
str2 = String[2];
const
WScommands : String[6] = ^@^D^E^S^X^J;
EXcommands : String[5] = 'MHKP;';
var
Orient : MenuOrientation;
Lev : Integer;
nullstr : str1;
pushstr : str2;
PushWord : Word;
begin {MenuCommand}
nullstr := '';
pushstr := '';
MenuCommand := True;
{Get the orientation of the current menu}
Lev := CurrMenu^.MenuLev;
Orient := MenuDesc[Lev].Orientation;
Mcmd := Mnul;
Ch := Readkey;
if Ch = Null then {possibly attempted to press a hot key}
begin
{Extended character, get other half and convert to WS format}
Ch := Readkey;
pushstr := Null+Ch;
Ch := WScommands[Succ(Pos(Ch, EXcommands))];
end;
case Ch of
^J : {F1}
Mcmd := Mhelp;
^E : {Up arrow}
if Orient = Vertical then
Mcmd := Mup;
^X : {Down arrow}
if Lev = 1 then
Mcmd := Msel
else if Orient = Vertical then
Mcmd := Mdown;
^S : {Left arrow}
if Lev <= 2 then
Mcmd := Mleft;
^D : {Right arrow}
if Lev <= 2 then
Mcmd := Mright;
^M : {Enter}
Mcmd := Msel;
#32 : if CurrMenu^.SubMenus^[CurrMenu^.SubCur].StatVal = 1 then {Space}
begin
ToggleBoolean := 2;
Mcmd := Msel;
end;
^H : if CurrMenu^.SubMenus^[CurrMenu^.SubCur].StatVal = 1 then {Backspace}
begin
ToggleBoolean := 1;
Mcmd := Msel;
end;
^[ : {Esc}
Mcmd := Mesc;
else
{Probably not a menu command -- this code allows hooks to hot keys}
{If a key which begins with a null, yet is not a valid menu command,
is pressed, this routine exits the menu system and puts the key into
the keyboard buffer to be processed by the calling routine}
MenuCommand := False;
{$IFDEF AllowHotKeys}
begin
if pushstr='' then MenuCommand := false
else
begin
MenuCommand := true;
Mcmd:=Mesc; {Exit the menus}
Move(PushStr[1],PushWord,2);
StuffKey(pushword);
end;
end;
{$ENDIF}
end;
end; {MenuCommand}
function MenuSelection(CurrMenu : Menuptr; Ch : Char; var sub : Byte) : Boolean;
{-Return true and a submenu number if ch matches a select character}
var
Found : Boolean;
begin {MenuSelection}
with CurrMenu^ do
begin
Ch := Upcase(Ch);
sub := 1;
Found := False;
while not(Found) and (sub <= SubMax) do
begin
with SubMenus^[sub] do
if @UserValidation <> nil then
begin
Found := (UserValidation(Command)) and
(Upcase(Prompt^[Soffset]) = Ch);
end
else Found := (Upcase(Prompt^[Soffset]) = Ch);
if not(Found) then
Inc(sub);
end;
end;
MenuSelection := Found;
end; {MenuSelection}
procedure UpdateItem(Menu : Menuptr; SubLast, SubCur : Byte);
{-Highlight the current menu item}
begin {UpdateItem}
DrawItem(Menu, SubLast);
DrawItem(Menu, SubCur);
end; {UpdateItem}
procedure DecCurSubmenu(Menu : Menuptr);
{-Move to the previous selection, and wrap}
var
SubLast : Byte;
begin {DecCurSubmenu}
with Menu^ do
begin
SubLast := SubCur;
if @UserValidation <> nil then
begin
repeat
if SubCur > 1 then
Dec(SubCur)
else
SubCur := SubMax;
until UserValidation(SubMenus^[SubCur].Command);
end
else
begin
if SubCur > 1 then
Dec(SubCur)
else
SubCur := SubMax;
end;
UpdateItem(Menu, SubLast, SubCur);
end;
end; {DecCurSubmenu}
procedure IncCurSubmenu(Menu : Menuptr);
{-Move to the next selection, and wrap}
var
SubLast : Byte;
begin {IncCurSubmenu}
with Menu^ do
begin
SubLast := SubCur;
if @UserValidation <> nil then
begin
repeat
if SubCur < SubMax then
Inc(SubCur)
else
SubCur := 1;
until UserValidation(SubMenus^[SubCur].Command);
end
else
begin
if SubCur < SubMax then
Inc(SubCur)
else
SubCur := 1;
end;
UpdateItem(Menu, SubLast, SubCur);
end;
end; {IncCurSubmenu}
procedure SetInitSelection(CurrMenu : Menuptr);
{-Assure initial menu selection is accessible}
begin {SetInitSelection}
with CurrMenu^ do
begin
if SubCur < 1 then
SubCur := 1;
if @UserValidation <> nil then
begin
while not(UserValidation(SubMenus^[SubCur].Command)) do
if SubCur < SubMax then
Inc(SubCur)
else
SubCur := 1;
end;
end;
end; {SetInitSelection}
function EvaluateMenuCommand(var CurrMenu : Menuptr;
Mcmd : MenuCommandType;
var Cmd : Integer) : Boolean;
{-Change current selection and current menu as indicated}
var
Done : Boolean;
Ch : Char;
begin
Done := False;
case Mcmd of
Mleft :
begin
{Move the root menu selection left}
DecCurSubmenu(RootMenu);
if CurrMenu <> RootMenu then
begin
UndrawMenu(CurrMenu);
with RootMenu^ do
CurrMenu := SubMenus^[SubCur].SubMenu;
SetInitSelection(CurrMenu);
DrawMenu(CurrMenu);
end;
end;
Mright :
begin
{Move the root menu selection right}
IncCurSubmenu(RootMenu);
if CurrMenu <> RootMenu then
begin
UndrawMenu(CurrMenu);
with RootMenu^ do
CurrMenu := SubMenus^[SubCur].SubMenu;
SetInitSelection(CurrMenu);
DrawMenu(CurrMenu);
end;
end;
Mup :
{Move the current menu selection up}
DecCurSubmenu(CurrMenu);
Mdown :
{Move the current menu selection down}
IncCurSubmenu(CurrMenu);
Mesc :
if CurrMenu = RootMenu then
begin
{Leave the menu system}
Done := True;
EraseMenus;
Cmd := 0;
end
else
begin
UndrawMenu(CurrMenu);
if CurrMenu^.MenuLev = 2 then
{Move back to the root menu}
CurrMenu := RootMenu
else
with RootMenu^ do
{Move back to level 2}
CurrMenu := SubMenus^[SubCur].SubMenu;
CurrMenu^.SubOn := False;
end;
Msel :
with CurrMenu^ do
if SubMenus^[SubCur].SubMenu <> nil then
begin
{Another menu below, display it and move to it}
SubOn := True;
CurrMenu := SubMenus^[SubCur].SubMenu;
SetInitSelection(CurrMenu);
DrawMenu(CurrMenu);
end
else
begin
{Bottom level menu, return a command}
Done := True;
Cmd := SubMenus^[SubCur].Command;
if @UserExitMenus <> nil then
begin
if UserExitMenus(Cmd) then EraseMenus;
end
else EraseMenus;
end;
Mhelp : if @UserHelp <> nil then
with CurrMenu^ do UserHelp(SubMenus^[SubCur].Command);
end;
EvaluateMenuCommand := Done;
end; {EvaluateMenuCommand}
function EvaluateSelectionCommand(var CurrMenu : Menuptr;
sub : Byte;
var Cmd : Integer) : Boolean;
{-Select from the menu based on a prompt character}
var
Done : Boolean;
SubLast : Byte;
begin {EvaluateSelectionCommand}
Done := False;
with CurrMenu^ do
begin
SubLast := SubCur;
if SubMenus^[sub].SubMenu <> nil then
begin
{Open up the selected submenu}
SubCur := sub;
SubOn := True;
{Update the screen}
UpdateItem(CurrMenu, SubLast, SubCur);
CurrMenu := SubMenus^[SubCur].SubMenu;
SetInitSelection(CurrMenu);
DrawMenu(CurrMenu);
end
else
begin
{Accept the command}
Done := True;
SubCur := sub;
{Update the screen}
UpdateItem(CurrMenu, SubLast, SubCur);
Cmd := SubMenus^[SubCur].Command;
if @UserExitMenus <> nil then
begin
if UserExitMenus(Cmd) then EraseMenus;
end
else EraseMenus;
end;
end;
EvaluateSelectionCommand := Done;
end; {EvaluateSelectionCommand}
begin {GetMenuChoice}
HiddenCursor;
ToggleBoolean := 0;
if CurrMenu = nil then
CurrMenu := RootMenu;
{Set the initial menu selection to an acceptable one}
SetInitSelection(CurrMenu);
if CurrMenu = RootMenu then
DrawMenu(CurrMenu)
else
{Menu already on screen, just update the items}
for sub := 1 to CurrMenu^.SubMax do
DrawItem(CurrMenu, sub);
Done := False;
repeat
if MenuCommand(CurrMenu, Ch, Mcmd) then
{Move the cursor, escape, or select the current submenu}
Done := EvaluateMenuCommand(CurrMenu, Mcmd, Cmd)
else if MenuSelection(CurrMenu, Ch, sub) then
{Select an entry by letter}
Done := EvaluateSelectionCommand(CurrMenu, sub, Cmd);
until Done;
ExitMenu := False;
end; {GetMenuChoice}
function InitMenus(MenuName : String; ColorTable : MenuAttributeArray;
UserDefinedHelpPtr,
UserDefinedValidationPtr,
UserdefinedEvaluatePtr,
UserDefinedExitMenusPtr,
BuiltInMenuAddress : Pointer) : Integer;
{-Set up the dynamic data structure of the menus}
var
br, InitPos, Smax, I : Integer;
Tmenu : Menuptr;
cm : file;
UserDefinedHelp : UserHelpType absolute UserDefinedHelpPtr;
UserDefinedValidation : UserValidationType absolute UserDefinedValidationPtr;
UserdefinedEvaluate : UserEvaluateType absolute UserdefinedEvaluatePtr;
UserDefinedExitMenus : UserValidationType absolute UserDefinedExitMenusPtr;
procedure InitMenuDesc(var MenuDesc : Menulevels);
{-Initialize general descriptions of each level of menu}
begin {Initmenudesc}
with MenuDesc[1] do
begin
Orientation := Horizontal;
Overlap := nil;
end;
with MenuDesc[2] do
begin
Orientation := Vertical;
Overlap := nil;
end;
with MenuDesc[3] do
begin
Orientation := Vertical;
Overlap := nil;
end;
end; {InitMenuDesc}
function GetInitByte(P : InitArrayPtr; var InitPos : Integer) : Byte;
{-Return the next byte from the menu initialization data}
begin {GetInitByte}
GetInitByte := P^[InitPos];
Inc(InitPos);
end; {GetInitByte}
function InitMenu(P : InitArrayPtr; var InitPos, Smax : Integer; var Tmenu : Menuptr) : Integer;
{-Initialize the parameters of one menu level}
var
Lev, Xp, Yp, Xs, Ys : Byte;
Smenu : Menuptr;
begin {InitMenu}
InitMenu := 0; {-assume success}
{Get the next six bytes from the initialization data}
Lev := GetInitByte(P, InitPos);
Xp := GetInitByte(P, InitPos);
Yp := GetInitByte(P, InitPos);
Xs := GetInitByte(P, InitPos);
Ys := GetInitByte(P, InitPos);
Smax := GetInitByte(P, InitPos);
if Smax = 0 then
{No items in this menu}
Tmenu := nil
else
begin
{Get the menu record and initialize it}
if MemAvail >= SizeOf(Menuptr) then New(Tmenu)
else
begin
InitMenu := -1; {-Out of memory}
Exit;
end;
with Tmenu^ do
begin
XPosn := Xp;
YPosn := Yp;
XSize := Xs;
YSize := Ys;
MenuLev := Lev;
SubMax := Smax;
SubCur := 0;
SubOn := False;
if MemAvail >= (SubMax*SizeOf(SubMenuRecord)) then
GetMem(SubMenus, SubMax*SizeOf(SubMenuRecord))
else
begin
InitMenu := -1; {-Out of memory}
Exit;
end;
end;
end;
case Lev of
1 : RootMenu := Tmenu;
2 : if RootMenu = nil then
begin
InitMenu := -2; {-Root menu must be specified first}
Exit;
end
else
with RootMenu^ do
begin
Inc(SubCur);
if SubCur > SubMax then
begin
InitMenu := -3; {-Too many submenus specified}
Exit;
end;
SubMenus^[SubCur].SubMenu := Tmenu;
end;
3 : if RootMenu = nil then
begin
InitMenu := -2; {-Root menu must be specified first}
Exit;
end
else
with RootMenu^ do
begin
Smenu := RootMenu^.SubMenus^[RootMenu^.SubCur].SubMenu;
if Smenu = nil then
begin
InitMenu := -2; {-Root menu must be specified first}
Exit;
end
else
with Smenu^ do
begin
Inc(SubCur);
if SubCur > SubMax then
begin
InitMenu := -3; {-Too many submenus specified}
Exit;
end;
SubMenus^[SubCur].SubMenu := Tmenu;
end;
end;
else
begin
InitMenu := -4; {-Error in level number in menu data file}
Exit;
end;
end;
end; {InitMenu}
procedure InitItem(P : InitArrayPtr; var InitPos : Integer;
var sub : SubMenuRecord);
{-Initialize the parameters of one menu entry}
var
Scord, Cord, Dofs, Spec, Sofs : Byte;
begin {Inititem}
{Get the next four bytes from the initialization data}
Scord := GetInitByte(P, InitPos);
Cord := GetInitByte(P, InitPos);
Dofs := GetInitByte(P, InitPos);
Spec := GetInitByte(P, InitPos);
Sofs := GetInitByte(P, InitPos);
{Store the record}
with sub do
begin
Soffset := Succ(Sofs); {String index where selection char is}
Doffset := Dofs;
StatVal := Spec;
Command := Cord+(Scord*256);
{Assume no deeper submenus}
SubMenu := nil;
{Store pointer to string}
Prompt := Ptr(Seg(P^), Ofs(P^)+Pred(InitPos));
{Skip over string}
InitPos := InitPos+Succ(P^[InitPos]);
end;
end; {Inititem}
procedure TraverseMenus(Menu : Menuptr);
{-Traverse the entire menu system, setting the current submenu to 1}
var
sub : Byte;
S : Menuptr;
begin {TraverseMenu}
with Menu^ do
begin
SubCur := 1;
for sub := 1 to SubMax do
begin
S := SubMenus^[sub].SubMenu;
if S <> nil then
{Recursive call to traverse the next level}
TraverseMenus(S);
end;
end;
end; {TraverseMenu}
begin {InitMenus}
{No root menu exists initially}
InitMenus := 0; {-Assume success}
RootMenu := nil;
{-Move passed parameters to globals we can keep around}
ScreenAttr := ColorTable;
UserHelp := UserDefinedHelp;
UserValidation := UserDefinedValidation;
UserEvaluateSpecial := UserdefinedEvaluate;
UserExitMenus := UserDefinedExitMenus;
{Initialize the menu descriptors for each menu level}
InitMenuDesc(MenuDesc);
{Initialize menu data}
if MenuName <> '' then
begin
Assign(cm, MenuName);
Reset(cm, 1);
if IoResult <> 0 then
begin
P := nil;
InitMenus := -5; {-Error opening the file}
Exit;
end
else
begin
MenuDataSize := FileSize(cm);
GetMem(P, MenuDataSize);
BlockRead(cm, P^[1], MenuDataSize, br);
if IoResult <> 0 then
begin
InitMenus := -6; {-Error reading the file}
Close(cm);
Exit;
end;
Close(cm);
end;
end
else
begin
if BuiltInMenuAddress <> nil then P := BuiltInMenuAddress
else InitMenus := -5; {-Error opening the file}
end;
InitPos := 1;
repeat
{Initialize a menu group}
MenuResult := InitMenu(P, InitPos, Smax, Tmenu);
InitMenus := MenuResult;
if MenuResult <> 0 then Exit;
if Tmenu <> nil then
begin
{Initialize the entries for the menu group}
for I := 1 to Smax do
InitItem(P, InitPos, Tmenu^.SubMenus^[I]);
end;
until P^[InitPos] = $FF;
{Set initial selections}
TraverseMenus(RootMenu);
{No menu is currently displayed}
CurrMenu := nil;
ExitMenu := True;
end; {InitMenus}
end.